Comprimir una imagen en blanco y negro usando PCA.
library(png)
tere <- readPNG('Image.png')
image(tere[,,1])
tereMat <- (tere[,,1]+tere[,,2]+tere[,,3])/3
dim(tereMat)
## [1] 960 720
# svdTere <- svd(tereMat)
#
# #Con SVD
# for(k in c(10,30,60,100)){
# print(k)
# image(svdTere$u[,1:k] %*% diag(svdTere$d)[1:k,1:k] %*% t(svdTere$v)[1:k,], axes = FALSE, col = grey(seq(0, 1, length = 256)))
# }
#Con PCA
calculaImagenReducida <- function(img, k) {
Data_mean = apply(img, 2, mean) #Saca la media de cada columna
a <- dim(img) #Dimensiones de la imagen original
Data_meanNew <- rep(Data_mean, a[1])
DataAdjust = img - Data_meanNew
cov_data = cov(DataAdjust)
eig <- eigen(cov_data)
V_trans = t(eig$vectors)
DataAdjust_trans = t(DataAdjust)
FinalData = V_trans %*% DataAdjust_trans
#PCs = a[2] - k
Reduced_V = eig$vectors[,1:k]
Y=t(Reduced_V) %*% DataAdjust_trans
Compressed_Data=Reduced_V %*% Y
Compressed_Data = t(Compressed_Data) + Data_meanNew
Compressed_Data
}
# for(i in c(2,10,30,50,100,300)){
# print(i)
# image(calculaImagenReducida(tereMat, i), axes = FALSE, col = grey(seq(0, 1, length = 256)))
# }
tati <- readPNG('Tat.png')
tatMean <- (tati[,,1]+tati[,,2]+tati[,,3])/3
dim(tatMean)
## [1] 960 960
image(tatMean, axes = FALSE, col = grey(seq(0, 1, length = 256)), main='Original')
for(i in c(10,50,100,350, 500)){
print(i)
image(calculaImagenReducida(tatMean, i), , axes = FALSE, col = grey(seq(0, 1, length = 256)), main=paste(i, 'componentes'))
}
## [1] 10
## [1] 50
## [1] 100
## [1] 350
## [1] 500
Implementa whitening en los datos faithful, compara las gráficas de los datos crudos y preprocesados.
Dats originales:
library(knitr)
kable(head(faithful))
| eruptions | waiting |
|---|---|
| 3.600 | 79 |
| 1.800 | 54 |
| 3.333 | 74 |
| 2.283 | 62 |
| 4.533 | 85 |
| 2.883 | 55 |
Media y matriz de covarianzas:
sapply(faithful, mean)
## eruptions waiting
## 3.487783 70.897059
cov(faithful)
## eruptions waiting
## eruptions 1.302728 13.97781
## waiting 13.977808 184.82331
Cov <- cov(faithful)
eig2 <- eigen(Cov)
E <- eig2$vectors
D <- diag(eig2$values)
Dinv2 <- diag(1/sqrt(eig2$values))
faithfulcent <- faithful - cbind(rep(sapply(faithful, mean)[1], nrow(faithful)), rep(sapply(faithful, mean)[2], nrow(faithful)))
WhitenedFaithful <- t(Dinv2 %*% t(E) %*% t(faithfulcent))
Los datos con whitening:
kable(as.data.frame(head(WhitenedFaithful)))
| V1 | V2 |
|---|---|
| 0.5932500 | 1.0117128 |
| -1.2451557 | 0.8236565 |
| 0.2260839 | 0.7864494 |
| -0.6573809 | 1.0714867 |
| 1.0372421 | 0.0459461 |
| -1.1660200 | -1.2087815 |
Media y matriz de covarianzas:
apply(WhitenedFaithful, 2, mean)
## [1] 4.265339e-16 6.873650e-16
cov(WhitenedFaithful)
## [,1] [,2]
## [1,] 1.000000e+00 -5.670137e-17
## [2,] -5.670137e-17 1.000000e+00
library(ggplot2)
ggplot(faithful) + geom_point(aes(x=eruptions, y=waiting)) + ggtitle('Originales')
ggplot(as.data.frame(WhitenedFaithful)) + geom_point(aes(x=V1, y=V2)) + ggtitle('Transformados')
library(rgdal)
## Loading required package: sp
## rgdal: version: 0.9-1, (SVN revision 518)
## Geospatial Data Abstraction Library extensions to R successfully loaded
## Loaded GDAL runtime: GDAL 1.10.1, released 2013/08/26
## Path to GDAL shared files: /usr/share/gdal/1.10
## Loaded PROJ.4 runtime: Rel. 4.8.0, 6 March 2012, [PJ_VERSION: 480]
## Path to PROJ.4 shared files: (autodetected)
library(ggplot2)
library(dplyr)
##
## Attaching package: 'dplyr'
##
## The following object is masked from 'package:stats':
##
## filter
##
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
pob <- read.csv('pobl.csv')
mun_shp <- readOGR("./municipios" , "MUNICIPIOS")
## OGR data source with driver: ESRI Shapefile
## Source: "./municipios", layer: "MUNICIPIOS"
## with 2463 features and 7 fields
## Feature type: wkbPolygon with 2 dimensions
mun_shp@data$id = rownames(mun_shp@data)
DF_shp <- subset(mun_shp, CVE_ENT == '09')
DF_df <- DF_shp %>%
fortify(region = "CVE_MUN") %>%
arrange(order)
## Loading required package: rgeos
## rgeos version: 0.3-8, (SVN revision 460)
## GEOS runtime version: 3.4.2-CAPI-1.8.2 r3921
## Polygon checking: TRUE
DF_df$id <- as.integer(DF_df$id)
DF_ind <- DF_df %>%
mutate(CVE = id) %>%
left_join(pob[,c('id','pob')])
## Joining by: "id"
ggplot() +
geom_polygon(data = DF_ind, aes(long, lat, group = group, fill = pob)) +
labs(title = "Población en el DF", fill = "Población") +
coord_fixed()